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( Start of UNIFORTH High-level Functions) 

3 CONSTANT 3 64 CONSTANT C/L 364 USER SCR 50 USER FLII 
34 USER R# 36 USER HLI 8 USER RO 16 USER FENCE 

HEX 16 BASE ! ; $ HOLD -i HLD +! HLD @ C! 35 
M/MOD >R O R@ U/MOD Re SWAF =R U/SMOD Ro 3 
*/MOD =R MK R> M/ 5 3° %/ &/MOD SWAF DROF 3; 


th OF He OF oe 


MOD /MOD DROF + _* ERASE 0 FILL }$ 
IMMEDIATE LATEST 64 TOGGLE 3 
HEX 
+ UPDATE PREV @ @ 8000 OR PREV @ ! 3+ 
==>) TLOANING. O-SEN AL BER His IMMEDIATE 
DECIMAL --> 


ao 


Conditionals) 
BACK HERE - 2» #3 
THEN ‘?COMP 2 ?PAIRS HERE OVER - SWAF ! + IMMEDIATE 
IF COMPILE OBRANCH HERE O + 2 + IMMEDIATE 
CCOMFPILE] -FIND O= IF ER1 ER2 THEN DROF CFA +» + IMMEDIATE 
ELSE 2? ?PAIRS COMFILE BRANCH HERE 0O + SWAF 2 
CCOMPILE] THEN 2 + IMMEDIATE 
BEGIN ?COMF HERE i + IMMEDIATE 
UNTIL 1 ?FAITRS COMPILE OBRANCH BACK 3 IMMEDIATE 
AGAIN 1 ?FAIRS COMPILE BRANCH BACK IMMEDIATE 
REPEAT >R =R CCOMFILE] AGAIN R> R> ~ 
CCOMPILEJ THEN + IMMEDIATE 
3 WHILE CCOMFILE] IF 2+ $ IMMEDIATE 


ee Te ee te OF 


co oe 4% oe 


Ph swe 


( DO-LOOFS) 

+ DO COMPILE (00) HERE 3 + IMMEDIATE 

+ LOOP 3 ?PAIRS COMFILE (LOOF) BACK # IMMEDIATE 

+; tLOOP 3 PRPAIRS COMPILE (+LO0OF) BACK $ IMMEDIATE 

+ (LINE) OR C/L B/BUF */MOD R> + BLOCK + C/L 3 

+ +" - 34 STATE @ TF DP @ COMPILE (€.-°) DP } WORD C@ 3 + 
=CELLS ALLOT ELSE WORD COUNT TYFE THEN + IMMEDIATE 

+ -FRAILING | DUP O DO 2DUP + 1 - €@ BL - IF LEAVE ELSE 1 - 
THEN LOOP ; 

+; MAX 2DUF < IF SWAP THEN DROP + 


we “yb 


Numoer Conversion) HEX 
SFACES O MAX TOUF IF O DO SPACE LOOF THEN 3 
St FAD HL ! 3 

#> DROF DROF HLD @ FAD OVER - ; 
SIGH ROT Of IF 020 HOLD THEN 3 

$¢ BASE @ M/MOD ROT ° OVER < IF 7 


¢ 
; THEN 30 + HOLD ¢ 
> #5 BEGIN #@ OVER OVER OR G= UNTIL 


mee op 


D+.R =R SWAF OVER DABS <# #5 SIGN 
D., oO D.R SPACE 3 

*R FR GS-30 Re OLR ¢ 

soe Das 


» R> OVER - SPACES TYFE 


? @ + F 
DECIMAL --> 


( Miscellaneous Block &% Error) 

; «LINE (LINE) -TRAILING TYFE 3 

+ PSAVE DUFF @ O< IF DUF @ 32767 AND OVER ! DUF DUFF 32+ SWAF 
@ O R/W THEN 3 

+; SAVE-BUFFERS FREY @ BEGIN ?SAVE +BUF O= UNTIL DROF 3 

$ FLUSH SAVE-BUFFERS ; 

+ MESSAGE WARNING @ IF TOUF IF 260 ,LINE SFACE THEN 
ELSE »" MSG# " . THEN ; 

+; ERROR ERI MESSAGE ER® 3 

+ PERROR SWAF IF ERROR ELSE DOROF THEN 3 


( TICK and FORGET) 
:* FIND Ge JF ERT «* Not found* ER2: THEN DROP 
CCOMFPILEY LITERAL 3 IMMEDIATE 


‘{ FORGET ( Forsdet mext word and all words after) 
ECCOMPILE] ’ NFA DUP FENCE @ Ux IF ERI ." Unforgettable" 
ER2 THEN =R VOC-LINK @ ¢ start with latest vocabulary) 


BEGIN R@ OVER Uz 
@ DUF VOC-LINK ! 
BEGIN DUF 2 - 


WHILE CCOMFILE] FORTH DEFINITIONS 


REFEAT 


( unlink from 


( stert with fenantom 


NFA) 


voc list) 


R@ Us 


UNTIL 


BEGIN PFA LFA @ DUF 
OVER 4 - | @ ?DUP O= UNTIL 
R> 2 - DF! 3 


( end of list?) 


Form Controls and YVLIST) 

UNPRINT «"° Unerintable Block" 3 

LF 10 EMIT 3 

FORM 12 EMIT + 

BS 08 EMIT 3 

BELL O7 EMIT 3 

VLIST ( list entire context vocabulary) 
128 OUT !' CONTEXT @ @ BEGIN OUT @ C/L 


oe 4 oH He oe oe 


IF CR O OUT ! 


THEN DUF ID, SFACE SFACE FFA LFA @ QDUF O= ?PTERMINAL 
OR UNTIL DROF 35 
K MX DROF 3 
/ /MOU SWAF DROP 3+ 
DECIMAL --> 


eo oF 


¥ 


CASE Statement) 


¢ 

+ $CASE RK» DUFF 2+ SWAF @ =R ER 3 

$ $=$ OVER = IF DROF R= 2+ =>R ELSE Rz @ =R THEN 
} $e) Re DROF ¢ 

+ NOCASE DUP 3 

+; CASE “ $CASE CFA » HERE O 5 3 IMMEDIATE 

¢ 3 ‘ €=$ CFA » HERE O + 3 IMMEDIATE 

a ae ’ $33 CFA » HERE SWAF ! 3 IMMEDIATE 

+; CASEND ¢’ R> CFA >» *’ DROF CFA » ’ DROF CFA >» 

HERE SWAF ! 3 IMMEDIATE 

( UNIFORTH LSI-1i/PDF-11 Assembler) 

+ OCTAL 8 BASE ! ; 

VOCABULARY ASSEMBLER IMMEDIATE 

ASSEMBLER DEFINITIONS 

oe Lane See 

; OF <BUILDS + DOES> @ > § 

( Common address and mumeric constants) OCTAL 

0 CONSTANT RO 1 CONSTANT Ri 2 CONSTANT R2 
3 CONSTANT RZ 4 CONSTANT R4 3 CONSTANT RS 
3 CONSTANT UF 5 CONSTANT SF 4 CONSTANT IF 
6 CONSTANT RF 7 CONSTANT FC 6 CONSTANT R46 
15 CONSTANT (SF) 25 CONSTANT (SF)+ 45 CONSTANT 

001000 CONSTANT NE 001400 CONSTANT EQ 100000 
160400 CONSTANT MHI 102000 CONSTANT VC 102400 
103006 CONSTANT CC 103400 CONSTANT CS 002000 
002400 CONSTANT LT 003000 CONSTANT GT 003400 
101060 CONSTANT HI 101400 CONSTANT LS 103000 
103400 CONSTANT LO 


QECIMAL --= 


? 


- (SF) 

CONSTANT 
CONSTANT 
CONSTANT 
CONSTANT 
CONSTANT 


€ Oecodes with one arsument) OCTAL 


OO5500 iOF ADC, 105500 10F ADCE, 006300 i10F ASL» 
106300 10F ASLE» 094200 10F ASK» 106200 10F ASRE» 
OCGO240 iOF CLEAR» 005000 10F CLR; 1905000 1OF CLRE» 
005100 10F COM; 105100 iOF COME, 005300 10F DEC, 
105300 10F DECE, 005200 10P INC; 105200 10F INCE, 
090100 10F JMF, 005400 10F NEG, 105400 10F NEGE, 
006100 10F ROL, 1066100 10F ROLE, 006000 10F ROR: 
106900 10F RORE» 060200 10F RTS» 005600 10F SEC, 
105600 10F SECK,r 000260 10F SET» 000300 10F SWAB, 
0046700 10F SxXT> 005700 10F TST» 105700 10F TSTE» 


+ EMTs 104000 + » 
DECIMAL --> 


“a> 


( Oecodes with zero or two arsuments) OCTAL 
040000 20F ALL» 


040000 20F BIC» 140000 20F BICEy, 050000 20F BIS» 
150000 20F BISK: 030000 20F BIT, 130000 20F BITE» 
620000 20F CFs 120000 20F CMFRB» 
004000 20F JSR» 010000 20P MOV; 110000 20F MOVE, 
074000 20F XORy» 160000 20F SUB» 
000003 OF BFT» 000257 OF CCCy 000241 OF CLCys 
600250 OF CLN» 000242 OF CLV», 000244 OF CLZ» 
900000 OF HALT» 000004 OF IOTs 006400 OF MARKs 
000240 OF NOF»s 006005 OF RESET» 9000002 OF RTI» 
000006 OF RTT» 000277 OF SCC, 000261 OF SECs 
000270 OF SEN» 000262 OF SEVs 000264 OF SEZ» 


OO00001 OF WAIT: 

( Sipegel instructions and addressing modes) OCTAL 
072000 EIS20F ASH» 073000 EIS20F ASHC, 

071000 EIS20F DIV, 070000 EIS20F MUL» 


$ ORCON <BUILDS » fHOESs @ OR 3; 

10 ORCON ) 20 ORCON }+ 30 ORCON @)+ 40 ORCON -) 

390 ORCON @-) 60 ORCON I) 70 ORCON @I1) 

27 CONSTANT #€ 37 CONSTANT @# 67 CONSTANT F 77 CONSTANT @F 


$ NEXTs R2 IF )+ MOVe, R22 @)+ IMF? 35 
i PUSH, -(SF) RO MOV» NEXTy 3 
$ POPs (SP)+ TST» NEXTy— ¥ 

DECIMAL --> 


Assembler conditionals) OCTAL 

HERE/ HERE 2/ 3 

NOT/ 400 XOR 3; 

IF; NOT/ HERE SWAF HERE/ 1+ - » ¢$ 

THEN, HERE/ SWAF +! 3 

ELSE, O IF» SWAF THEN» 3 

BEGINy HERE/ 3 

UNTIL» NOT/ SWAP HERE/ i+ - 377 AND + » 3 
WHILE, IFe + 

REFEAT, HERE/ SWAF +! HERE/ i+ - 377 AND » 3 
SOB, HERE/ i+ SWAF 100 * 77000 + SWAF ROT - 77 AND + 29 3 
DECIMAL -- > 


Te OO Oe HH OH OH OH OH OH GH ON 


( End assemoler.,-define high-level functions) 

+ END-CODE ¢ Terminate 3 machine-lansuase word) 
TEXEC ?CSP SMUDGE CCOMPILE] FORTH 3} IMMEDIATE 

FORTH TEFINITIONS 

+ CODE (¢ Create @ machine-lansuase word) 
PEXEC !'CSF CREATE CCOMFILE] ASSEMBLER ; IMMEDIATE 

' sCODE ¢( like DOES> excert for machine code) 
?CSP COMPILE (CODE) CCOMFPILE] C CCOMFILE] ASSEMBLER }; 
IMMEDIATE 

+ SUBROUTINE ¢ subroutines only callable by CODE-words? 
PEXEC !CSF VARIABLE SMUDGE -2 ALLOT CCOMFILE] ASSEMBLER 

IMMEDIATE 


( FORTH-79 words «++ 2-r2/yJSe FICK) 


CODE 2- ( m--- n-2) 
(SF) TEC: (SF) DEC, NEXTs END-CODE 
CODE 2/ Cas = i722) 
(SF) ASR» NEXT> END-CODE 
CODE 2x C ho === ax2) 
(SP3 ASL»: NEXT> ENTD-CODE 
CODE J ( -k- ml .s+Put 2nd index on TOS) 
-(SP) 4 RF I) MOV, NEXT: ENTI-CODE 
+; FICK ( mi --- get mith stack value to TOS) 


UF + SF@ + @ + 


. 


( FORTH-79..+ROLL» DEPTH: NOT, FIND,» EXIT» MOVE>? U.) 


CODE 20ROF ¢ Ni N2 --- 4... DROF 2 STACK VALUES) 
(SP)+ (SF)+ CMF, NEXT» END-COLE 
CODE ROLL C mi --- «++rotate mith element to TOS) 


Ri (SF)+ MOV, 1 # Ri CMP, GT IFyr Ri DECy SF Ri ALD», 
SP Ri Alls RO (SF) MOVy BEGINy 2 SF I) -(SF) MOV, 
Ri SOB» (SF) RO MOVs THEN: NEXTs END-CODE 
NOT O= 3 
FING -FIND IF DROF ELSE O THEN 3 
EXIT R> DROP 3 ( exit from word) 
MOVE 2k CMOVE 3 
Ure 50. Te 4y 
DEFTH SF@ SO @ SWAF - 2/7 3 
79-STANDARL + ( we have standard system) 


tt FF OO $e oe OH Oe 


x 
? 


( Miscellaneous} 


CODE MAXI ( --- m eoeeSet max it centr from ret stack) 
~(SF) 2 RF I) MOV, NEXT, END-CODE 
s EXPECTEE ( adr #char --- «+esame as EXPECT excert b1 fill) 


2OUURP EXPECT 1 DO DUF I + C@ O= IF DUP I + MAXI I - 
BLANKS LEAVE THEN LOOF ITIROF + 
GETNUM C ineut mumher from keyboard) 

-1 FRECIS ! FAD 20 BLANKS FAD i+ 17 EXFECTBL FAD i+ Ce 
IF PAD NUMBER FRECIS @ O= IF DROF THEN THEN 3; 

(SB) C run-time routine to fetch string) 

R@ DUP C@ i+ =CELLS R= + =R 3 


? 


o* 


« 


( LIST,» INDEX > 
CODE CONTROLS? C adr ent -—-- t/f eseany ctrl cheers in buf?) 
Ri (SP)+ MOV, RO (SP) MOV, (SF) CLRr R2 32 # MOVs 
BEGINs RO 3+ R2 CMFB»y LE IFr SWAF Ri SOR, ELSE, 
(SF} 1 #€ MOVs THENs NEXTs END-CODE 
7 EES ( mi --- .+-slists screen mi) 
BASE @ SWAF TECINAL CR DUF SCR ! ." SCR # " DUF , 
BLOCK 1024 CONTROLS? IF UNFRINT 15 0 DO CR LOOF ELSE 
16 6 DO CR I 3 .R SFACE I SCR @ .LINE LOOF THEN CR BASE ! 3 
+ INDEX ( ind n2 --- .+Prints ist line of SCRKs ni-n2) 
it SWAP TO CR I 3 .R SPACE OI (LINE) CONTROLS? IF 
UNFRINT ELSE 0 I .LINE ?TERMINAL IF LEAVE THEN THEN LOOF ; 


soe some “te 


( System Service Calls) OCTAL 

CODE DIRS ( adr --- t/f .++execute directives leave err fl} 
RP -) (SF MOV, 377 EMT,» CS IFr (SF) i # MOV, 
ELSE+y (SF) CLR, THENr WNEXTr END-CODE 

CODE DIRS¢S ¢€ mi m2 e+ ent --- t/f «eedymamic directive call) 
R2 (SP)+ MOV, REF RO SUBy RP R2 SUBy RI RF MOV, 
BEGIN» Ri 3+ (SFP)+ MOVs R2 SOR, 377 EMTr CS IF» 
‘2 INC, THEN: -(SP) R2 MOV, NEXTe END-COTE 


+ WAIT ¢€ efm --~ «+ewait for event fleas) 
1051 2 DIRSS IF ." WTSE? error"* ABORT THEN 3 
DECIMAL --> 
( RSX-11M file maming -- 1) 
VARIABLE FOS1 VARIABLE FOS2 VARIABLE DKNT ¢ wrks spece) 
} DESCR ¢ --- adr ...,address of file mame descrirtor) 
FCB @ i0 + 3 
$ ACCTYF ¢€ --- adr ..-adr of record access word) 
FCB @ 8 + 3 
} OFTYF ¢ --- adr «++adr of ocren-tyre word) 
FCB @ 6 + 3 
Hier Sas ( adr --- find colon in ineut string if present) 


COUNT 20UP ORKNT ! FOSi ! OVER FOS2 ! O LO DUF 
C@ 58 = IF I it FOS2 +! LEAVE THEN it LOOF DROF 3; 
J? ¢ find bracket in inrut string if rresent) 
2 @ DUFF FOS1L ! DKNT @ O DO DUP C@ 93 = IF I it 
2 +! LEAVE THEN 1+ LOOF GROF ; 


oe 


( RSX-11M file interface -- 4) 
VARIABLE TEMFNAME 150 ALLOT (¢ storage for old FIB) 
{ SWITCH-TO ¢ close current, switch to another file) 
STATE @ IF COMPILE SAVE-BUFFERS COMPILE CLOSE-FILE ELSE 
SAVE-BUFFERS CLOSE-FILE THEN CCOMPILE] OFEN-FILE + IMMEDIATE 
$ LGALD-FROWN ¢ blk --- «.-load fr 2nd files ret to ist) 
SAYE-BUFFERS EMFTY-BUFFERS CLOSE-FILE FCB @ TEMFNANE 
152 CMOVE CCOMFILE] OFEN-FILE LOAD SAVE-BUFFERS 
EMP TY-EBUFFERS CLOSE-FILE TEMFNAME FCE @ 152 CMOVE (OPEN) 
DROF 3; 
CR ." Basic System is mow loaded. * 


( UNIFORTH extension load block 4++c 1982 Unisoft) 
CR ." Loading besic extension, rlease waite..." 


CODE JLT! ( addr --- ¢ssinecr contents of addr by 1) 
RO (SF)+ MOVs RO ) INCr NEXT, END-CODE 
CODE 2+! ( addr --- «seiner contents of addr by 2) 
RO (SP)+ MOV», RO ) INCy RO ) INCr NEXT, END-CODE 
CODE i-! ( addr --- 4,.-decr contents of addr by 1) 
RO (SF)+ MOVs RO ) DEC» NEXT END-CODE 
CODE 2-! ( addr --- 4.-decr contents of addr oy 2) 
RO (SF)+ MOV, RO ) DECr RO ) DECr NEXT END-CODE 
CODE i- Cin =-- n-1) 


(SF) DECys NEXT» END-COLE 


.. 


( Indexing words --2) 
CODE @t+ ( mi m2 --- n3 .4+fetehn n2r add to mi) 
RO (SF)+ MOV, (SF) RO >) ADD, NEXT, END-CODE 
CODE +8 C mi m2 --- m3 .+-add mi to m2, fetch) 
(SF) (CSF)+ ADDys (SF) O SF @I) MOVe NEXT, END-CODE 
COLE @! C mi mn? --- .4,fetch m2, store mi at contents of m2) 
RO (SP)+ MOVs O RO @I) (SF)+ MOV, NEXT» END-CODE 
CODE COM (€ mi --- n2 4.+complement 16-bit value) 
(SF) COM» NEXT» END-CODE 
COUE -ROT ¢ md cn? fig === nS ndon2) 


Ri (SF)+ MOV, RO (SF)+ MOVs R2 (SF) MOVy (SF) Ri MOVy 
-(SF) R2 MOV, FUSH, END-CODE 


( RSX-11M file naming -- 2) 
+ 'DEY ( adr --- fill device name field in filename block) 

+? FOSi @ POS2 @ OVER - DUP IF BUF NEGATE DKNT +! 

DUP 4 FICK ! ROT 2+ @ SWAP CMOVE ELSE 2DROF 0 SWAF ! THEN 3 
> PULE € adr --- fill user ident field in filename block) 

J? FOSi @ FOS2 @ OVER - DUP IF DUP NEGATE DKNT +! DUF 

4 PICK ! ROT 2+ @ SWAP CMOVE ELSE 2DROF O SWAF ! THEN 3 


; INAM € adr --- fill file name field in filename olock) 
UKNT @ DUF 3 FICK ! SWAF 2+ @ FOS? @ SWAF ROT CMOVE ; 
> (CIBDESCR) € adr --- «.-fill filename block from string) 


DESCR DUF ROT !DEY 4 + DUP !UIC 4 + INAM 3 
+ IDESCR ¢ fill 211 fields of filename block) 
32 STATE @ IF DF @ COMPILE (S@) DF ! WORD C@ 3 + =CELLS 
ALLOT COMPILE (!DESCR) ELSE WORD (!DESCR) 
THEN 3 IMMEDIATE 


REN<LPH-P its Shtenrede: 24 45 


( 
+ READONLY ( --- ...+S5et oren-tyure to read) 
O OFTYF !] 5 
> MODIFY ( --- 4..set oren-tyre to read/write/modify) 
LOORTYP: 3453 
+ SEGMOTE ( --~ «e+5et access-mode to sea record) 
O ACCTYF |! + 
+; RANMODE ( --- 4++85e@t 3ccess-mode to ran record) 
2 ACCTYP |! ¥ 
}; BLKMOTE ( ~~~ 4++5e@t a@ccess-mode to blocked I/O, ie FORTH) 


1 ACCTYF ! 3 


2G 
( RSX-11M file interface -- 3) 
+ =MAKE> ( create file whose descriptor is already stored) 


+" Rec Tyre (1l=fixy 2=var?3=sea)! * GETNUM 
+" Rec attrib (O=noner 1=LF/CR», 2=FORTRAN: 8=FORTH)? * 
GETNUN 
+" Mex rec size (512=FORTH)! " GETNUM 
-10 -10 (MAKE) 3; 

+ MAKE-FILE ¢ create file) 

SAVE-BUFFERS CLOSE-FILE !DESCR <MAKE> O= IF 

*" Error? MAKE-FILE* QUIT THEN 3 


{ RSX-11M file interface -- 3) 

* OPEN> (¢ oFen file whose mame is im FCE) 
(OPEN) O=/IF ERCODE -26 = IF .* File not found, 
+" To vou want it created? (Y/N)!" KEY DUP 
EMIT -33 AND 89 = IF CR <MAKE> THEN ELSE 
+" KX Orpen Error Xk " QUIT THEN THEN 3 

+ OFEN-FILE (¢ oren file whose name is next on command line) 
STATE @ IF CCOMPILE] !DESCR COMPILE <OFEN: ELSE 
CCOMFILE] !DESCR <OPEN: THEN > IMMEDIATE 

>; EYE (¢ return to RSX-11) 

CLOSE-FILE ENT 3; 


32. 


( TO-LOOF Indexing words) 


COKE I+ (jimi --- niltI .«++add index to TOS) 
(SF) RF ) ADD, NEXT, END-CODE 
CORE I- (imi --~- mi-I ..+-sub index from TOS) 
(SF) RF >) SUBs NEXT, END-CODE 
CORE I2k+t C mi --~ mit2*I ..-used for array indexing) 


RO RF ) MOV, RO RO ADDy (SF) RO ADD, NEXT» END-COLE 


( DO-LOOPF Indexing words --2) 
CODE [2x+! ( mi m2 --- store nl at n2t2xI) 
RO RF >) MOVs RO RO ADI, RO (SF)4+ ADD, RO ) (SFI+ MOV, 
NEXT, END-CODE 
CONE I2*+e C mi --- m2 ..-feten m2 from mit2*I) 
RO RF ) MOV, RO RO ADD, RO (SF) ADD: (SF) RO } MOV, 
NEXT: END-CODE 


34 


( Touwble precision integer extension) 

CODE 28 ( addr --- di ..-fetcn double) 

Ri (SF) MOV, RO Ri )+ MOV? (SF) Ri ) MOVs FUSH:s END-COLE 
2VARIABLE VARIABLE 2 ALLOT ; 

0->S OROF ¢ 

2ROT 6 ROLL 6 ROLL 3 

ZOVER 4 FICK 4 FICK 3 

2SWAF 4 ROLL 4 ROLL 3 

[i- ONEGATE [+ 35 

fox SWAF DROF Of ¢ ; DO= O= SWAF G= ANT 3 
[= ROT = -ROT = AND 3 : De D- Dor 5 

UMAX 2OVER 2O0VER [l< IF 2@SWAF THEN 20)ROF 3 

DUMNIN 20VER 20VER De O= IF 2SWAF THEN 20ROF 3 


to FF OO HH HH Fe HO OD HH 4H 


( End of double precision extension) 

CODE <2! ( di addr --- ...store double) 
RO (SF)+ MOV, RO 9+ (SF)4+ MOVs RO ) (SF)+ MOV, 
NEXT: END-CODE 


CODE 2:R ¢ dq --~- 4.+FuSsh double to ret stack) 
RF -) (SA)+ MOV: RF -) (SF)+ MOV, NEXT, END-CODE 
CODE 2R> ( --- d .+-+Por double from ret stack) 


-(SP) RP D+ MOV, -(SF) RP )+ MOV>y NEXT» END-CODE 


36 


( Memory move and text comrpzerison routines) 

CODE -CAOVE ( adri adr2 mobstes --- «..move ste at end) 
R2 (SF)+ MOVs RG RO MOV: Ri KR2 MOV, 
Ril (SF)+ ADD: RG (SP)+ ADD, R2 TST, NE IFy 
BEGINs Ri -) RO -) MOVE, R2 SOK+ THEN» NEXTy 
END-CODE 


CODE CMFS € adri adr2 nmoytes --- flasd .2+-17071 string cme) 
RO (SP)+ MOV, R2 (SFi+ MOVy Ri (SP) MOV, (SF) O #€ MOV, 
RO TST» NE IFr BEGIN» R2 )+ Ri )+ CMFEB, EQ IF» 
SWAF RO SOB, ELSEs LT IF» (SP) DEC: ELSE, (SF) INC, 
THEN: THENys THEN? NEXT? END-CODE 


{ Text comrearison words) 

+ MATCH ( adri enti adr? ent? --- T/F/adr) 
ROT OVER - DUP O< IF DROF 20ROF 0 ELSE 
1+ 0 00 3 FICK 3 FICK 3 PICK CMFS IF ROT 1+ -ROT 
ELSE 20ROF O LEAVE THEN LOOF IF 20R0F O THEN THEN 3 


Printing words) 
BINARY 2 BASE ! 35 


oe ee os 


Oo, ( Frint in unsigned octal regardless of base) 
BASE @ OCTAL SWAF U. BASE ! 35 
t He ( Print in unsigned nex regardless of base) 
BASE @ HEX SWAP U. BASE ! 3 
+ PTRASE ( Print base im decimal) 


BASE @ DUF DECIMAL . BASE ! + 
+ (VALUE) O TUF ROT CONVERT 20ROP 3 


( Array words) 
+ ARRAY ( meells --- ..-create nm cell buffer) 
“BUILDS 0 D0 0 » LOOF DOES: + 
Sas So 6 | ( meells --- ,4,,,creates indexed array) 
“BUILDS 0 DO 0 +» LOOF DOES: SWAF 2x + 35 
+ DDIM C mi --- «+-+creates dee. indexed array ml elements) 
“BUILDS 2k O DO 0 » LOOF DOES: SWAF 2k 2k + + 
* Che SIM ( mrows meols --~- 4442 dimension array) 
“BUILDS OVER + k O 710 0 » LOOF DOES: 
DUF @ ROT xk ROT + 2k + 3t 3 
$ OCIyJODIM ¢€ nmi n2 --- ..-define mixn2? de matrix) 
<BUILDOS SWAF 2* DUFF » * HERE SWAF O D0 0 » LOOF DOES: 
DUP @ ROT) * ROT + 2k 2* 2+ + 2+ 3 


Array words --2) 
INIGEN ( adr ncells --- 4.-set elements eaual to index) 
GO DO I QVER I2x+! LOOF ORGF ; 


( next words fill array from stack, in form? } 
¢ c< ni fe MS «se nn edr >> ) 
¢ which Futs mn values into array starting at adr) 
VARIABLE #$DUMMY 
aes ( mark stack tor for filling array) 
SF@ $DUMMY ! 35 
$ o> ( mark end of fills fill array) 
$0UMMY @ SP@ - 6 - OVER + DO I ! -2 +LOOF ; 
{ Block operations --1) 
; COFY ( blki b1lk2 --- 4,.,cories blk1l into b1k2) 
SWAF BLOCK SWAF BUFFER 1024 CMOVE UPDATE SAVE-BUFFERS ; 
; EXCHANGE (¢ b1lki oO1kK2 --- ..-+-exchandes blocks) 
BLOCK 2- DUP @ ROT BLOCK 2- DUF @ ROT -32768 OR 
ROT ! -32768 OR SWAF ! SAVE-BUFFERS 3 
$$ CLR-BLK ( DIKE --- ..-set to blanks b/#S in front) 
BLOCK 21307 OVER ! 23+ 1022 BLANKS UPDATE SAVE-BUFFERS 3; 
¢; BMOVE ( old mew #blks --- 4.+-move multirele blocks) 
“R SWAP R> O TO 20UF I+ SWAF I+ COFY LOOF 2DROF 3; 
> ~BMOVE ¢ old new to1lks --- «+-move multirele from end) 


“R SWAP) R@ + 1- SWAF DUP i- R> + DO DUP I COFY i- -1 
+LOOP DROP + 


( Memory dump words) 

+ DUMF ( addr meells --~ 44-dume in 16-bit form) 
CR DUF +; OVER + DUP ROT DO I060.R ." $" DUF I 16 ¢ 
MIN I DOL YT @ BASE @ 10 = IF 7 «sR ELSE O 7 DsR THEN 
2 +LOOF CR ?PTERMINAL IF LEAVE THEN 16 +LOOF DROF 3 

+; HOUMF BASE @ =R HEX DUMF R> BASE ! + 

; ODUMF BASE @ =R OCTAL DUMF R> BASE ! ¢ 

+; COUMPF ( addr noytes --- 4.4+dume im 8-bit form) 
BASE @ >R CR HEX O DO DUP I+ DUFF OS D.R .* ¢* 
16 0 TO DUFF It C@ 3 .RK LOOF SFACE 146 O DO DUF I+ Ce 
127 AND DUF 32 <= IF DROF 46 THEN EMIT LOOF DROF CR 
?PTERMINAL IF LEAVE THEN 16 +LOOF DROF R> BASE ! 3 


( Miscellaneous) OCTAL 
$ PREY ?TERMINAL IF KEY ELSE O THEN 3 
$ LINE SCR @ (LINE) DDROF + 
CODE V+ ( a@ be d --- ate btd »«+-vectored add) 
2 SF I) (SF)+ All, 2 SP I) (SF)+ ADD, NEXT» ENTDI-CODE 
J ARRAY MRKT ¢ mark-time deb) 
we 2427 27, 0) 1, O MARE > 
> MS ( mi --- hardware delay oy mi milliseconds }) 
74 1750 */ MRKT 4 + !' MRAT DIRS DROF 17 WAIT 3 
+ REMSPACE ( calculate remaining dictionary srace & print) 
SO @ HERE - ." You have "*" U. ." oyutes of memory left" 3 
DECIMAL --> 


tf 


FORTH-79? words) 


>; PBLK BASE @ DECIMAL PREV @ @ , BASE ! 3 
s:°(O2 (Ox + OF= Of NOT + 
} 5 eae tate = ae oe Oe > O= N OT + 

- = NOT 3 ; >= << NOT 3 

:; Of= OF NOT 3 >; Ur= Ue NOT ¢ 

; Ut= 2OURP Ux -ROT = OR 3 

>; U> SWAP Ux 3s 


( arithmetic shift) 
CODE SHIFT ( mi nn? --~- m3-+-6-Aritnmetic shift mi by n2 bits.) 
C if m2O- shift left. m2>Or right. m2=0 mo shift) 
Ri (SP3+ MOVs RO (SP)+ MOV, Ri TST» NE IF» 
GT IFy BEGIN,s RO ASKy Ri SOBy ELSE Ri NEG, BEGIN» 
RO ASL» Ri SOB, THEN> THEN>s PUSH: END-CODE 


* 


: DU ( udl ud? --- f «.-test two unsigned 32-bit values) 
ROT 20UP Us IF 20ROF 20ROF 1 ELSE Ux IF 20ROF 0 ELSE 
Ux IF i ELSE 0 THEN THEN THEN + 


( Frinter Interface ares --1) OCTAL 
CODE FREMIT € char ~--- o+sPPrint char) 


(SFP3+ TST: NEXTe ENDT-CODE 
$ PRINTER 1) IOBYTE ! + 
+ TERMINAL oO IOQBYTE ! + 
TERMINAL 
DECIMAL --> 


( SFAWN and BATCH directives ~-- 1) OCTAL 
1411 CONSTANT .ATXCC ¢ IO.ATT!ITF.XCC) 
2000 CONSTANT .DET 
’ @TERMINAL CFA @ 14 + CONSTANT ASTENTRY (¢ loc of ast rout) 
44 ARRAY CMDLINE ¢ seawn command line entry) 
15 ARRAY SFOFB ¢( srawn DPB) 
<< 6413 50712 131574 0 0 0 0 26 0 0 CMDULINE 110 O SFDFB => 
14 ARRAY TTOFB ¢ terminal QIO DFB) 
°<£ 6003 .ATXCC 5S 27 0 O ASTENTRY O 0 0 0 O TTIFE 
$ ATTACH (¢ attach terminal) 
*ATXCC TTOPBR 2+ ! TTDFER DIRS DROP 35 
: DETACH ( detech terminal) 
~UET TTOFB 2+ ! TTDFB DIRS OROF + 
DECIMAL --> 


{ SFAWN and BATCH directives -- 2) OCTAL 

+; GOMD ¢€ get command line from terminal) 

134 WORD COUNT DUF SFORFB 26 + ! CMDULINE SWAF CMOVE 3 

+ SPAWN (€ issue srunt command?) 

GCMDO 26 SFOUFPB 14 + ! DETACH SFOFE DIR¢ DROF 24 WAIT ATTACH } 
BATCH ¢ like srawn but returns immediately to console) 

GCMD 30 SFDOFB 14 + ! SPOFB DIRS DROF 3; 

ALUNS ¢€ m --- 4«4+a5sidnm logical unit number) 

40 WORD DUF 2+ NUMBER DROF SWAF 1+ DUF C@ SWAF i+ C@ 400 x 4+ 
ROT 2007 4 DIRS Of IF ." LUN assn error" QUIT THEN 3 
NECIMAL --* 


> 


oe 


€( RSX-11 Date and Time words -- 1) OCTAL 

10 ARRAY TBUF ¢ TIME&DATE BUFFER) 

VARIABLE TIFB 1075 TOFB ! TRUF + O » 

$ GETTO TOPB DIRS DOROF 3; 

+ SETTO 1475 TOPB ! TOFB DIR$ DROF 1075 TOFE ! 3 
HEX 

' «TIME ¢ print time on terminal) 

GETTO TBUF 6 + @ 2 .R 3A EMIT TBUF 8 + @ 2 ,.R 
SA EMIT TBUF OA + @ 2 .R SFACE 3 

+UATE ¢ frint date on terminal) 

GETTD TRUF 2+ @ 2 .R 2F EMIT TRUF 4 + @ 2 LR 
2F EMIT TBUF @ 2 .R SPACE 3; 


e+ 


DECIMAL -->» 
5od 
( RSX-il Dete and time words -- 2) HEX 


+; DATE ¢ store date in TBUF array) 
*" Enter date (MM/DID/YY)3 " PAD 9 EXPECT 20 FAD 24+ C! 
FAD i- (VALUE) TBUF 2+ ! 20 PAD 5 + C! FAD 2+ 
(VALUE) TRUF 4 + ! 320 FAD 8 + C! FAD 5 + (VALUE) 
48 - TBUF ! TBUF 6 + 6 -1 FILL SETTI 3 

+; ITIME ¢ store time in TBUF array) 
TBUF 6 4l FILL 
+" Enter time (CHHiMM)? “* FAD 6 EXFECT O TBUF OA + ! 
20 PAT 2+ C! FAD i- (VALUE) TBUF 46 + ! 20 FAD 5 + C! 
FAD 2+ (VALUE) TBUF 8 + ! SETTI 3 

DECIMAL --> 


( Block listing words) 
TYNAME (¢ Print file name) 

+" F,NAME= " DESCR @ ?POUP IF DESCR 2+ @ SWAF TYFE THEN 
DESCR 4 + @ ?PTOUF IF DESCR 6 + @ SWAF TYPE THEN 

QNESCR 10 + @ DESCR 8 + @ TYFE 3 


+ 


$ CBLIST ( iblk1 bIkK2 --- ..-list 1 thru 2 inclusive) 
it SWAF DO CR I LIST KEY 27 = IF LEAVE THEN LOOF 3; 
; TRIAD (inl m2 --- «selist 3 blks/radge incl ml thru n2) 


3 / 3 * 3 OQVER + SWAF DO CR I LIST LOOF CR 
+" UNIFORTH Version 2,05 " 4 SFACES TYNAME 4 SFACES 
*DATE 3 SFACES .TIME FORM 3 

SHOW ( DIK1 bI1K2 --- ..,-list blks in triad form) 
i+ SWAF 3 7 3 * TO I TRIAD ?@TERMINAL IF LEAVE THEN 
o sFEGOP. 


+ 
* 


wel ( Fils-Oriented Extensions -- 1) 
* RTYF € nm --- 4,.eRrint access tyre) 
+" ReTYRE=" DUP i = IF .* R.FIX® ELSE. TUF: 2° -= TF 
+" K+VAR" ELSE .* R.SEQ" THEN THEN DQROF CR 3 
* RATT ( erint print control attribute) 
+" Attribute= * DUP 1 AND 1 = IF ," FO.FTN" THEN DUF 2 ANT 
2 = IF ." FD.CR* THEN 8 AND 8 = IF .°* FIi.BRLK" THEN CR 3 
* RSTIZ ¢€ nm --- «eePrint max record Slze) 
+" Mex ReSIZE= * . ." bytes" CR } 
+; HOWOFEN ( frint oren-tyre info ) 
+" Orened fort " FCR @ @ 35 + C@ DUP 1 AND IF ," Ri,* 
THEN DUF 2 AND IF ." WRT.* THEN LUE 4 AND IF 
+" EXT.°| THEN DUP 8 AND IF .* CRE," THEN DUF 16 ANI 
IF ." TMP." THEN 32 AND IF ." SHR,* THEN 3 


( File-Oriented Extensions -- 2) 

+ ISITOFEN ( print whether file is oren) 
-" File is? " FCB @ @ 56 + @ IF «* oven" ELSE 
*" closed" THEN 3 


; HIBK ( do --- ..-Print highest block in file) 
*" Hishest alloc. blk= " D. CR } 
3; EFRR ( do --- «serrint end-of-file Dlock#) 


o* EOF bhock= * BD. CR 3 
? FILESTATUS (€ main status-finding word) 
TYNAME CR FCE @ @ DUP C@ RTYP it DUF C@ RATT i+ DUF @ 
RSIZ 2+ DUF 2@ HIBK 4 + 2@ EFBK HOWOFEN CR ISITOFEN 3 
+ COPYATOB |( ni n2 --- ...cory block ni fileA to n? filek) 
SAVE-BUFFERS FILEA EMF TY-BUFFERS SWAF BLOCK SWAF FREY @ 1 
UPDATE FILER SAVE-BUFFERS FILEA 3 


54. Task Expansion -- 1) OCTAL 
VARIABLE EXBEYTES ( #bytes to exrand/contract) 
1000 CONSTANT MINSTACK ¢ minimum @llowed stack size) 
20 ()DIM DATBUF ¢ get task buffer) 


+ $EXTK (¢ #byutes --- extend task +-) 
100 / 0 SWAF 1531 3 DIR$S O< IF ." Can’t extend" QUIT THEN ; 
+ $GTSK ( --- get task rarameters,y store in DATBUF > 
O DATBUF 1077 2 DIR$S DROF ; 
: PRICT (¢ 4-- t/f weetrue if not enuf Srace) 
SF@ HERE - EXBYTES @ ABS 2/ - MINSTACK ae 
+ PTTASK (¢ 4-- t/f ..strue if not enuf task seace for ext) 
177777, 15 DATBUF @ 0 D- EXBYTES @ 9 Ds 5 
DECIMAL --=> 
( Task Expansion -- 2) 
+ PSPACE ( }--- ...checks limits, auits if mot in range) 


EXBYTES @ O< IF ?DICT IF ." Not enuf dict space" QUIT 
THEN ELSE ?TASK IF ." Not enuf task srace* QUIT THEN THEN ;3 


( ¥kk EXPAND MUST BE FOLLOWED BY COLD xxx ) 
>; EXFANII ( m --- 4.+exrand/contract task n bytes) 
64 / 64 k EXBYTES ! $GTSK ?SPACE EXBYTES @ $EXTK 3 


CK .* Basic extension is now loaded," CR 


( UniF ORTH Video Editor load block «...,coryright 1982 Unisoft>) 
CR .* Loading video editors Flease waite..." 
VOCABULARY EDITOR IMMEDIATE EDITOR DEFINITIONS 


5 32 * ARRAY MENARR ¢ menu array storage) 

78 BLOCK MENARR 5 64 x CMOVE ¢ fill menu from olk 78) 
VARIABLE CURFOS ¢ current cursor position) 

1 CONSTANT LOW?SUF ( if true: convert lower to urrer case) 
VARIABLE #STLINES ¢ # of lines om line stack) 

VARIABLE INSTGL ( if truer insert mode..,.,todgdled) 


e 


( Terminel Derendent Characteristics +++ YVT-100) 
to Loa C ni mn? --- seeeprint nmi in m2 fields,» zero filled) 
oR G->D SWAF OVER DABS <# R> 0 DO # LOOF SIGN #> TYFE + 


CsI ( Control Seauence Introducer, ESC [) 
27 EMIT 9L EMIT 3 
CURU CSI 65 EMIT 
CURR CSI 67 EMIT 
CEOL CSI 7S EMIT 


+ 


$ CURD CSI 66 EMIT 
+ CUnG “C51 48--ER FT. 
+ (HOME. CSE. 72 ENE 


oo oe oe 
“a> sap “OP 
“a+ sar “or 


FAGE CSI 50 EMIT 74 EMIT 3 

BRIGHT CSI 49 EMIT 109 EMIT + 

DIM CSI 48 EMIT 109 EMIT 35 

GOTOXY ( & wv --- oeemove cursor to columm & line) 
CSI 1+ 2 2+R 59 EMIT 1+ 2 Z.R 72 EMIT 3 


to +e ee Oe 


General cursor movement commands) 


( 

$ GXY ( --- « yu eeefrom currosn) CURFOS @ 64 /MOD 3 

+ ,CUR ¢ move cursor to new xey) GXY 4 6 Vt GOTOXY + 

; $I CUR ( val --- .+.set cur rosm) O MAX 1023 MIN CURFOS ! + 
t |1,CUR ¢€ val ---...store and move cursor) ICUR .CUR 3 

: +CUR ( val ---+.,inecrement cursor) CURFPOS @ + !CUR ¢ 

t +.CUR (¢€ val --~+++iner move cursor) +CUR .CUR + 

+ L## ( --- line¥® «++from curros) CURFOS @ 64 / 3 

} +LIN ( line# --- «++move cursor to new line) 


L## + 64 x ICUR 3 
»HOM ( move to ‘home’ eosmn) O !.CUR $ 
( move cursor right) CURFOS @ 1+ DUF 1024 < IF 
QUF CURFOS !' 64 MOD IF CURR ELSE .CUR THEN ELSE DROF THEN + 
,CURL (€ move cursor left) CURFOS @ i- DUP O2>= IF DUP 
CURFOS ! 64 MOD 63 = IF .CUR ELSE CURL THEN ELSE DROF THEN 3 


+e + 
+> 

mo 

| eam 

=x 

7 


“e 


( Words to control terminal) 
t LTOS ¢ --- addr... of line stack TOS) 
HERE 128 + #STLINES @ 64 ® + # 
t MENU (€ erint menu at tor of screen) 
HOME MENARR 5 O TO 0 I GOTOXY I 64 * OVER + 
64 TYPE LOOF DROF 69 17 GOTOXY ." Block#" 3 
: SIDES ¢( put sides and linet on screen) 
14 0 DO 10: I. 6 + GOTOXY I 14 2 .R BL ENDL? £24. ENIT 
48 I 6 + GOTOXY 124 EMIT LOOF 3 
¢ DOTL ¢€ erint 66-column dotted line) 
466 0 DO 45 EMIT LOOF + 
$ TEDOT ( print lines at tor & bot of block) 
3.5 GOTOXY DOTL 3 22 GOTOXY DOTL +» 
+ CEETPNE ( mnehar ---+.+-emits mehar blanks) 
3L EMIT LOOF 3 


( Block srintin# words) 
> BLCMH ( blank emd line 2 rosition cursor at bed) 
0 23 20UF GOTOXY 79 CLLINE GOTOXY }3 
$ BLSTR ( blank string line &% Position cursor at bes) 
0 4 20UP GOTOXY 79 CLLINE GOTOXY ; 


+ TYLINE (¢ |S# L# --- ...tyres linet on TOS to screen) 
4 OVER 6 + GOTOXY LINE 64 TYPE ; 
; FRBELK ( print block on sereen) 
0O I TYLINE LOOF ; 
+} «BLK ( print black on screen) 
BRIGHT 71 18 GOTOXY SCR ? 16 0 FRELK .HOM 3} 
+ TYCMD ¢ tyre command line at bot of screen) 


8 23 GOTOXY #STLINES @ 2 .R 13 23 GOTOXY 64 TYFE .CUR }; 
+ VLST ¢ fill screen frorerly) 
FAGE [DIM TRDOT SIDES MENU #STLINES @ IF LTOS TYCMD THEN ; 


( Tsbbinsd cursor F/B one word) 
>; FWD ( move cursor one word forward) 
SCR @ BLOCK 1024 CURFOS @ DO I OVER + C@ BL <> IF 
1024 I DO I OVER + C@ BL = IF I !.CUR LEAVE 
THEN LOOF LEAVE THEN LOOF DROF 3 
+; BRWD ( move cursor one word backward ) 
SCR @ BLOCK CURFOS @ O DO CURFOS @ I- 20DUF + Ce 
BL <> IF DUF O DO 20UP I- + C@ BL = IF DUE 
I- !,CUR LEAVE THEN LOOF LEAVE THEN 
DROP LOOF DROF ; 


Add/delete lines) 
LFOS (¢( --- 1L# ..scursor line#t1) L## i+ + 
ADDL ( add 3a blank line om cursor line) 
L## DUP 14 DO I LINE DUF 64 + 64 CMOVE -1 +LOOF 
LINE 64 BLANKS UPDATE 16 L## FRBLK ; 
$ DELL ( delete @ line at cursor rosition) 
LPOS DUF 16 < IF i6 SWAF DO I LINE DUF 64 - 
64 CMOVE LOOF ELSE DROF THEN 15 LINE 64 
BLANKS UFDATE 16 L## FRBLK .CUR 3 


To ee oN 


( Line stacks insert mode todsling) 
+ TGLINSERT ( tod#sle insert mode ON/OFF) 
0 23 GOTOXY INSTGL @ 1 XOR DUP INSTGL ! IF 


¢" Insert? ELSE ,* "THEN 3 
+ FUTL ( linet --- 4.,.ruts line on line stack) 
LINE DUP LTOS 64 CMOVE #STLINES i+! TYCMD 3 
>; GETL ( line# --- 4... replaces line w/linestack TOS) 


FSTLINES @ IF LINE DUP #STLINES i-! LTOS SWAF 64 CMOVE 
UPDATE 4 L## 6 + GOTOXY 64 TYFE #STLINES @ IF LTOGS 64 - 
TYCMD ELSE 8 23 GOTOXY 49 CLLINE .CUR THEN ELSE DROF THEN 3; 
+ DISFLAY ( diselay current block) 
1 INSTGL ! TGLINSERT O CURFOS ! .BLK 3 


( eharecter manirulation words) 
TCLINE ( tyre line at char rosition) 
20DUP 4 & V+ GOTOXY LINE OVER + 64 ROT - 
-TRAILING ROT IF 1+ THEN TYFE .CUR 3 
'CHAR ( store char in olock at cursor position) 
DUP EMIT SCR @ BLOCK CURFOS @ + C! UPDATE CURFOS @ 1+ DUF 
64 MOD IF CURFOS ! ELSE DROF 1 +,.CUR THEN 3 
COEL ( delete character st cursor Frosition) 
1 GXY¥Y 2DUP LINE DUFF 63 -+ -ROT + 20UP —- OVER 1+ 
-ROT CMOVE BL SWAF C! TCLINE UFDATE 3; 
; *CHAR ( move lines insert char: retyure) 
GXY 20UP LINE OVER + SWAF 63 SWAF - OVER it SWAF 
-~CMOVE ROT !' CHAR O -ROT TCLINE UFDATE 3 
$ CLREOGL € clear to end-of-line from curros) 
CURFOS @ 64 GXY DROF - O DO BL !'CHAR LOOF !,CUR 3; 


eo 


+ 


+ 


( String mode functions --1) HEX 
10 ARRAY TEXA 16 ARRAY TEXB (¢ strins comprare storage) 
O VARIABLE DELIMN oO VARIABLE ?MOTE 
+ DELSTR ( mehar --- 4+-deletes at current rosition) 
0 10 CHEL LOOF 3; 
ALUISTR ( adr menaer --- «++inserts chars at curros) 
© TO DUP I+ C@ =CHAR LOOF DROF 3; 
+; REFSTR ( adr mehar --~- «+,rerlaces charsa at curros) 
6 DO DUF I+ C@ !'CHAR LOOP DROF ; 
+; LOWUF DUR 60 > OVER 7B < AND IF 20 - THEN 3 
. EYES ( --- t/f 4+-cnecks next key for YrN or ESC) 
KEY DUF ih = IF NEGATE ELSE LOWUF 59 = THEN } 
+ DELWD ( delete word at cursor rosition) 
SCR @ BLOCK CURFOS @ + BEGIN CDEL DUF C@® BL = UNTIL 
CIEL DROF 3 
DECIMAL --> 
( Strind mode function -- 2) HE X 
$ =KREY KEY DUF EMIT + 


+ 


RUBOUT ¢ olank last char) BS BL EMIT BS 3 
ISTRING ( addr --~- «++store into adr until delim) 
DUF BEGIN =KEY DUP DELIM @ = OVER OL = OR IF 
DROF i ELSE DUF 7F = IF DROF RUBOUT i- ELSE OVER C! it 
THEN O THEN UNTIL OVER - SWAF i- C! 3 
“FIND =REY DELIM ! TEXA 1+ !STRING ; 
“REF SFINID TEXR i+ !STRING 3+ 
FSTR ( find first occurrence of 3 string) 
CURFOS @ SCR @ BLOCK OVER + 040600 ROT - TEXA COUNT MATCH ; 
+ STRINFQ ( print info line for strings mode) 
BRIGHT 0 3 GOTOXY 79 CLLINE 10 3 GOTOXY 
+" Strinsgmode? FsrelsRCdelISTRiCdelISTR2Cdel]" > 
DECIMAL --> 


++ t+ oe 


( String mode funetion --- 3) HEX 
; STRMODE ( find out which mode is desired) 


STRINFO BLSTR =KEY LOWUF CASE 
446 =! |>FIND -1 #3 ( find strind) 
AG =} FIND GO 33 ( delete string) 
S2 =% REP 1 oF? ( rerlace strings) 
Wror 


NOCASE =} ak 
CASEND ?PNODE ! 3 
t MOVSTR ( move TEXB into pblock) 
TEXB C@ TEXA C@ - CASE 
O =t TEXBR COUNT REPSTR #3 
DUP O> 1 =! TEXB it TEXA C@ REFSTR TEXB it 
TEXA C@ + SWAF ADLTSTR #3 
DROF DUP O< 1 =f ABS DELSTR TEXE COUNT REFSTR #3 
CASEND 3 
DECIMAL --> 
( String mode function -- 4) HEX 
$ FIXSTR ( do something to the located string) 
?YES DUF O>= IF O= ?PMODE @ O< OR IF TEXA C@ +CUR 
ELSE ?MODE @ CASE 
=? JEXA C@ DELSTR 53 
1 =3 MOVSTR #7 
CASEND THEN 0 ELSE DROF BLCMI .».HOM 1 THEN 3 
$ PROMPT ( main search word.-continues till NQ) 
®MODE @ 2 <> IF BEGIN FSTR DUF O= IF DROP BLCHD 
." No match.++next block (Y/N)i" ?YES IF SCR it! 
DISFLAY 0 ELSE 1 THEN .HOM ELSE SCR @ BLOCK - !CUR 
BLCMD ."| This strings (Y/N/ESC)3"* +CUR FIXSTR THEN 
UNTIL THEN BLCMD DIM MENU BRIGHT .HOM + 


if entry!!" 700 MS 2 #3 


QECIMAL --> 

( Basic cursor movement?) HEX 

; PMOVE ( move cursor) CASE 
OC =F »CURL O 9% ( left) 
Os =3 »CURL QO FF ( also left? 
12 =3 » CURR O Fs ( pigsht) 
C4 =$ 40 +,CUR O 33 ( down) 
15 =! -40 +.CUR O #3 ( ur) 
On =} 1 ¢LIN .CUR © 353 ( new line) 
O07 =} »HON O $3 ( home on screen) 
OS =3 1 +LIN CURFOS i-! .CUR O #3 ( end-of-line) 
OF =3 -1 ¢LIN .CUR O #3 ( old line?) 


DUP CASEND 3 ( and leave char on TOS) DECIMAL 
$ JBLK ( jump to new block) 

71 18 GOTOXY TEXA it !STRING BL TEXA COUNT + C! 

TEXA (VALUE) SCR ! DISFLAY + 


( Control and character cases ) HE X 
$ PCNTRL ( basic block contol) 
CASE ih =: FAGE FLUSH DIM QUIT 73 ( endsflush3 
18 =t PAGE EMPTY-BUFFERS DIM QUIT +3 ( exityvabort) 
OF =t SCR 1+! DISPLAY 0 37% ( next block) 
10 =: SCR 1-! DISPLAY O #3 ( previous block) 
TD =2"° BPELK OO 2 ( Jjume block) 
DUP CASEND + 
¢ CINS ( looe for insert mode) 


TGLINSERT .CUR BEGIN KEY CASE 

Ooo =f. ITGLINSERT, 3 CUR 2) «e39 

7F =3 «CURL COEL O #3 

DUP O1F > IF >CHAR ELSE DROF THEN 90 DUP 
CASEND UNTIL UFDATE »* 


( Basic character Fositionings) HEX 


; ?PCHAR ( basic enesracter rositioning) 
CASE O46 =} FWD G 933 ( move fwd 1 word) 
O02 =3 BRWE O F3 ( move okwd 1 word) 
OF =} CINS G 33 ( insert mode) 
7F =i | COEL O $3 ( delete mode) 
1C =$ STRMODE FROHFT © 33 ( string mode) 
17 =? BL 2CHAR O 33 { insert blank) 
1A =; DELWH O $3 ( z23F word) 
DUFF CASENT - 
DECIMAL --* 
( Line ¢3se and main editing word) HEX 


$ PLINE ( addedelsvrerlace lines) 


CASE O1 =? ADDL »CUR O $3 ( add olenk line) 
OR = DELL .CUR 9 33 ( delete line) 
14 =$ L## PUTL .CUR O $3 ( trans line to stack?) 
1? =} L## GETL .CUR O 33 ( yank line from stack) 
16 =} CLREOL O 33 ( clear to end-of-line: 


TUF CASEND 3 
DECIMAL FORTH DEFINITIONS 
ceed Sk DLS 9 eee eG Ee oO LOck) 
EnITOR 
SCR ! 0 #STLINES ! VLST DISFLAY BEGIN 
KEY PMOVE ?PLINE ?PCHAR ?PCNTRL DUP 31 > IF 
'CHAR UPDATE 0 ELSE DROF O THEN UNTIL 3 
FORTH 
75 
a5 


“G=esgohome “L=left “R=right “Usur “L=down “F=fwds “Rebak tana 
“Q=old line “E=end of line CR=next line “V=yoid to EOL 
“K=ekill line! “A=z=add line “T=trans tor “Y=yvank from line stack, 
_[iEL=del char “Z=zar wd “I=inserts, “\=string modes “Wewrt blank 
Exits? ESC=flushy “X=no flush Block! “Ferrev, “N=new, “~J=Jume 


( Terminal Uerendent Characteristics ++ YT-100) 
OL vente C miom2 --- «eerprint mi in m2 fieldss zero filled) 
“R S->0 SWAF OVER DARS <# R> O DO #€ LOOF SIGN #> TYPE } 


+ (GSE ( Control Seauence Introducer, ESC £) 
27 EMIT Fi EMIT + 
CURU CSI 165 EMIT 
CURR CSI |é7 EMIT 
CEEOL. CST V5 EMLT 


CURD CSI 46 EMIT 
CURL. CSI °6e EMIT 
HOME. CSt..72-EN1T 


te oo we 
“a> sce “ae 
th +e oe 
a a 


FAGE CSI (50 EMIT 74 EMIT 3; 

BRIGHT CSI 49 EMIT 109 EMIT ; 

DIM CSI 48 EMIT 109 EMIT 3 

GOTOXY ¢€ x yu --- 4e-emove cursor to column & line) 
CST bt o2 eR -S9 EMT Lh 2 - Z2eR 72 EMIT 3 


ve oe ee oH 


terminal derendent cnaracteristics.4.+:+H-19?) 
CURU 27 EMIT 65 EMIT > : CURD 27 EMIT 66 EMIT 3 
CURL 27 EMIT 68 EMIT $ CURR 27 EMIT 6&7 EMIT 
HOME 27 EMIT 72 EMIT 2 PAGE. 2 7-ENR DT 69-EMLE 
CEQL 27 EMIT 75 EMIT 
GOTOXY ( xval sval --- ...d0to “ry FOoSrnesWwrt urprer left) 
27 EMIT 89 EMIT 0 MAX 23 MIN 32 + EMIT 
O MAX 79 MIN 32 + EMIT 3 
BRIGHT 3 
DIM + 


“> “OE 


oe Oe ee ee oe oe | 
a 


f +> eo 


terminal derendent characteristics... .,TVI-912C) 

CURU Li EMIT 3 CURD. <PO:sEM LT «3 

CURL O8 EMIT 3 GURR- 12 EMIT 3 

HOME 30 EMIT 3$ FAGE 26 EMIT 3 

CEOL 27°EMIT 84 EMIT 3; 

GOTOXY (| xval yuval --- ..,.s0to xeY¥ FOSMe+wWwrt uprer left) 
27 EMIT 61 EMIT 0 MAX 23 MIN 32 + EMIT 
O MAX 79| MIN 32 + EMIT 35 

$ BRIGHT 3¢ 


to Oe Oe HH Oe 
++ oe +e 


$ TIM 3 

( terminal derendent characteristices.+.+.-+ANM-3) 

2 sBURU LE SEMI 9 + CURT 16 EMIT ; 

: CURL O08 EMIT 3 > CURR) -12- EMT 3 

$+ HOME 30 EMIT 3 $ FAGE 26 EMIT 35 

; CEOL 27 EMIT 84 EMIT + { cle3r to end-of-lined 

; GOTQXY ( xval uval --- ...d0to Mey FOSMe wrt uprer left) 


Ae ERE SL EME (0 MAX 23 MER: Se. + ENDL 
O MAX 79| MIN 32 + EMIT 5 

BRIGHT + 

DIM ¢ 


| +e o¢ 


ee ee Ee Oe ee 


te +e 


Terminal-derendent Characteristics for 310i) 


CURU 27 EMIT 65 EMIT 
CURL. 27 EMIT 69 EMIT 
HOME 27 EMIT 72 EMIT 
CEGL 27 EMIT O9 EMIT + 
GOTOXY 27| EMIT 89 EMIT 
SWAF EMIT EMIT 3 

BRIGHT 3 

CIM + 


“ah Sah sae 


+ CURD 27 EMIT 66 EMIT ; 
CURR 27 EMIT 67 EMIT + 
PROE “27 ENST 76 EMILE 9 


oe +h 


23 MIN SWAP 79 MIN 32 32. Vt 


( Line Editor load block...,coryright 19682 Unisoft) 
VOCABULARY LEDITOR IMMEDIATE LEDITOR DEFINITIONS 

32 ARRAY TEXT 32 ARRAY TEXA 32 ARRAY TEXR (¢ text storeade) 
256 ARRAY TEXC ¢€ line stack buffer)? 64 CONSTANT 64 


VARIABLE C# ( cherecter rointer) 
VARIABLE L# ( line Fointer) 
VARIABLE DELIMITER 94 DELIMITER ! ( string delimiters caret) 


bd Le ONTO INE Ce: > 
Lh) eGR S-LSSt Cis 
Bt SCR it! L » -- RS. “SER: Dats ey 


[ ++ +4 oe 


Line editor basic line commands) 

SPACES? 64 -TRAILING + 

SUF DUR L# ! LINE DUP C# ! ¢ 

BLANKIT 44 BLANKS 3 

H DUP SUF TEXT 64 CMOVE + 

T H LINE SFACES? 2 SFACES TYPE CR 3 

RK SUF TEXT SWAF 64 CMOVE UFDATE ¢ 

OD DUP H iS < IF i5 SWAF DO I i+ LINE DUF 64 - 64 CMOVE 
LOOGF ELSE DROF THEN 15 LINE BLANKIT UPDATE + 

E H LINE BLANKIT UFDATE + 

II DUFF 14 0 I SUF TUF 464 + 64 CMOVE -1 +LOOF i+ RF 3 

Le EF 2.3 $7 eB DUE ERS a es 


Pe Fe Oe OH oe HH OH ON 


lvweresces 


( Line entering commands) 

} BR ( rerlace lines» including linet on tos) 
146 SWAF TO CR I . 2 SFACES CR TEXT 464 EXFPECTBL 
TEXT C@ IF I R ELSE LEAVE THEN LOOF ; 

$ EI ( insert lines after linet on tos} 
16 SWAF [DO CR I. 2 SFACES CR TEXT 64 EXFPECT&SL 
TEXT C@ IF I II ELSE LEAVE THEN LOOF 3 


( Line editor multirle line commands) 


ama ea © ( mi m2 --- delete lines mi thru m2) 
i+ OVER DO DUF Ti LOOF DROF + 
HT ( mi mn? --- tyre lines nmi through m2) 
1+ SWAF TO I TUF . T LOOF + 
Slee ( mi m2 --- blank lines nmi througn m2) 
i+ SWAF DO I E LOOF 3+ 
? LH ( mi n2 --- hold lines mi througn m2 on line stack) 


i+ TEXC SWAF ROT DO I H DROF TEXT OVER 64 CMOVE 44 + 
LOOF DROF + 


¢ CR (ni mn? --~- rerlace lines mi thru m2 from line stack) 
i+ TEXC SWAF ROT DO DUF TEXT 64 CMOVE 64 + I F LOOF DROF 3; 
o LL ( ni n2 --- insert lines ni thru n2 from line stack) 


OVER O<> IF i+ THEN TEXC SWAF ROT DO BUF TEXT 44 


WME LA 1Hne TROP 3 


( Line editor strings -- 1) 
+; STRING ( delim --- feteh string into TEXT) 
TEXT BLANKIT WORK COUNT TEXT SWAF CMOVE j; 
> " 34 STRING 3 + €¢C 41 STRING ; 
; GSTR € get delimited string, leave adr 2 ent on tos} 
DUF DELIMITER @ HORD DUF C@ 1+ ROT SWAF 
CMOVE COUNT + 
CIN) + ( get mext mumber from ineut buffer) 
“IN @ TEB @ + C@ DUP BL > IF SIN 1+! THEN ; 
7 WREKA ( Just workings word for following fens) 
OVER O LINE - 64 / L#¥ ! T? + c# ! 3 
+ MP ¢ if stress not matcher print error) 
C# @ 15 LINE 64 + OVER - 2SWAF MATCH DUP O= IF CR 
*" No meteh"* THEN DUP Li 3 


7. 


( Line editor strings -- 2) 

+; ADJ € adjust line? chaedrs dele CN-0o] on tos) 
DUP O<> IF OVER O LINE - 64 / 1+ 64 * O LINE + DUF 
“R ROT SWAF OVER - TEXA C@ TEXE C@ MAX - OVER TEXA Ce 
+ ROT TEXB C@ + ROT 4 ROLL O< IF CMOVE R> TEXA C@ 
TEXB C@ - OVER SWAF - [DG BL I C! LOOF ELSE R= DROF 
-~CMOVE THEN ELSE 20ROF THEN 3 

+; REFLIM ( set rerest limits) 
DUP 48 < IF DROF 49 THEN 48 - 0 3 


$° GEL ( get srr si command line) 
TEXA GSTR TEXB GSTR 20ROF (IN)+ REFLIM } 
$ MTEXT ( Mave text to line after making room for it) 


AJ TEXB COUNT C# @ SWAP CMOVE UFDATE C# @ TEXB C® WRKA 3 


( Line editor string commands) 

: SF ( Searen for string and tyre line) 

TEXA GSTR (IN)+ REFLIM DO 20UP M? IF DUP C# |! TExA 
C@ WRKA ELSE DOROF LEAVE THEN LOOF 2nROF 3; 

+ SR ( Search for string,» replace with second strings) 
GCL DO 20UF M? IF DUF C# ! TEXB C@ TEXA C@ - MTEXT 
ELSE DROF LEAVE THEN LOOF 2IROF 3 

+ SI ¢€ Search for strings insert second strings after) 

GCL DO 20UF M? IF TEXA C@ + DUP Ct ! TEXB C@ TEXA ® =R 
O TEXA ! MTEXT R> TEXA ! ELSE DROF LEAVE THEN LOOF 20RGF 3 

; SII ( Telete string) 

QO TEXE ! TEXA GSTR (CIN)+ REPLIM DO 20UF M? IF DUP C# ! 
TEXA C@ NEGATE ADJ C# @ O WRKA ELSE DROF LEAVE THEN 
LOOF 20ROF UFDATE 3; 


( Line editor block string commands) 
; BSR ( blo bhi --~- rer stras between blks) 

Li TEXA GSTR TEXB GSTR 20ROF 2SWAF 1+ SWAP DO I SCR | 
CR Li." Block * I, BEGIN 20UF M? IF DUP CE ! TEXR 
C@ TEXA C@ - MTEXT © ELSE DROP 1 THEN UNTIL ?TERMINAL 
IF LEAVE THEN LOOF 2DROF ; 

+ BSF ( blo bhi --- find strings between blocks) 
Li TEXA GSTR 2SWAF 1+ SWAF DO I SCR ! CR Biock * 
I. Li BEGIN 20UP M? IF DUF C# ! TEXA C@ WRKA O ELSE 
QOROF 1 THEN UNTIL ?TERMINAL IF LEAVE THEN LOOF 2?DROF 3 


( Line editar..s.main editing word) 
} > a 
rile Vhs 
FORTH DEFINITIONS 
LEDIT SCR ! CCOMFILE] LEDITOR LEBITOR L FORTH ; 
S 


he 


( UNIFORTH SYSGEN load block) ¢ 3/27/83 AAH) 

FORTH DEFINITIONS DECIMAL ¢ RETURN VOCABULARY TQ FORTH) 
LATEST 12 +ORIGIN ! ( TOF NFA) 
HERE 28 +O0ORIGIN ! © FENCE) 
HERE 30 tORIGIN ! C Desks 
VOC-LINK @ 32 +ORIGIN ! ( YVOC-LINK) 


30 ARRAY TEMNAN 
+ GETVALS C ineut number routine for reallocate) 
CR +." Number of olocks (2 to m)t " GETNUM 
CR ." New memory size in Kbytes (32-645 ESC=current): * 
GETNUM 3 
> ENDALL ( print terminating messages for reallocate) 
-*" Enq reallorste, SYSGEN or COLT to limits" CR 3 


Sse mew 


( UNIFORTH SYSGEN -- 2) F 
$ REALLOCATE (¢ echansde init memory size and thuffers) 
GETVALS FRECIS @ O« IF 34 +ORIGIN @ ELSE 1024 *® THEN 
QUF 36 +ORIGIN !§ DUF 2+ 4060 +0RIGIN ! 
LIMIT @ - OVER #BUFF - B/SBUF 4 + &k - 24 146 DO DUP 
I +ORIGIN +! 2 +LOOF 34 +ORIGIN +! 38 +ORIGIN ! ENDALL 3 
- RICEPICE ( cory mem imase of forth to .tsk file in B3 
QO +ORIGIN 1 BLOCK OVER + OVER 1624 SWAF - CMOVE 
UFDATE HERE 0 1024 U/MOD SWAP O<> + 14+ 2 LO 
I i- 1024 * I BLOCK 16024 CHOVE UFDATE LOOF SAVE-RUFFERS 3 
; FIXFCE ( resets feb to files in mew .-tsk) 
FILEA FCER @ FILER FCB 0 1024 U/MOD 1+ BLOCK + ! 
UPDATE SAVE-BUFFERS 3 


( UNIFORTH SYSGEN -- 3) 

* PEELENG ( fill file name block from console infut} 
TEMNAM 1+ > 50 EXFECTBL TEMNAN 1+ 5O -TRAILING TEMNAM C! 1- 
NESCR DUFF ROT ! DEV 4 + TUF !UIC 4 + !NAM 3 

+ DEFFILE { reset filea to default file) 
SAVE-BUFFERS EMFPTY-BUFFERS FILEA CLOSE-FILE 
>" Source file sou wish ofFened uron FORTH execution? * 
FILLFNB FILER 3 

? NEWTASK ( get mew task image file orened: 
+" Task image file on which imese is toa be stored: 
FILEB FILLFNE (OFEN) + 

$ SYSGEN ( main system generation word) 
DEFFILE WNEWTASK FILLFILE FIXFCR CLOSE-FILE 
FILEA C(OFEN) CR ." End of susden with def file oren on A*® 


( UNIFORTH SYSGEN -- 2 ) ( 3/27/83 AAH) 

20 ARRAY TNAME 

$ XX 32 WORD HERE C@ 1+ HERE TNAME ROT CMOVE 35 

XX SYO? FORTH. TSK FORGET XxX 

$ WRTASK (¢ Ferform actual task image write) 
FILEA © BLOCK UFDATE 1 BLOCK UFDATE FILEB SAVE-BUFFERS 
20UROF 0 1 BLOCK 512 + S12 CMOVE UFDATE HERE 512 - 0 
1024 U/MOD SWAP O<> + 2+ 2 DO I 1- 1024 * 312 - I BUFFER 
1024 CNOVE UFDATE LOOF SAVE-BUFFERS CLOSE-FILE FILEA 3 

>; CRTASK ( ecreete new task image file) CR 
-" Enter filename for new task image? " FAD i+ 60 EXFECTEBL 
FAD 1+ 60 -TRAILING FAD C! FILES FAD !DEV !UTC INAM 

1 8 512 HERE 0 512 U/MNOD SWAF O<> + 6 + 10 (MAKE) + 


( 


7S 


UNIFORTH SYSGEN -- 3 ) € 3/27/83 AAH) 


SYSGEN ( Main word, reauires all set B4 execute) 
SAVE-BUFFERS EMPTY-BUFFERS FILEA READONLY BLKMODE 


TNAME 'TEY 'UIC INAM (OPEN) 
CRTASK WRTASK 3¢ 


COLE ¢€ redefine to first extend task image if necessary) 


$GTSK 13 DATRUF @ LIMIT @ - EXPAND COLO 


a 


==> Floating Point Utility information block 

This utility is modified heavily from one by R. Leighton, Calif, 
Inst. Technology, It uses IEEE compatible 32-bit floating 
POint arithmetic. Nom FORTH-79 words reeuired b4 loadings? 


E+ ( x ¥ --- 2 » where z=xt¥y) 

b= ( x Y --- Z » where z=xn-y) 

FX ( & yo or-- = » where z=“ky) 

F/ C xX Y --- 2 » where z=/y) 

FLOAT ¢€ dd --- = » 32-bit float function) 
FIX ( = --- do» 32-bit fix function) 
FNEGATE ¢ x --- E-x] + mesate) 


ERI»ER2 together eaual ABORT + 2k is 2 * 3 l= ig ]> = 
O=> is O= NOT 
Note} need dsp, extensionrs and NUMBER mods for fir, Loreiut 


{ Floating Point Load Block...Ce] 1982 Unisoft) 
+ IFLOAT ¢ float 16-bit integer) S->I FLOAT } 
3) TETX ( fix to 16-bit integer) FIX DROF 3; 

+ FABS ¢€ « --- agbsE€x]) 32767 ANTI 3 

+ F@ ¢€ adr --- x) 22 3 

$F I Cx agr =<--) 21 ; 

> FSWAP ¢ # ¥ --- yu x) S@SWAF 3 

+; FOROFP ¢ »~ ---) 2D0DROF 3 

+ FOVER ¢€ 4 ¥ --- x» yu x) BOVER 3 

>; FROT CMY Bocm— aoe >} “SROT 3 

> FOIUF ( No o-- x ) 2OUF 5 

: . ML X2e<= %1 x2 RT 62) “2OVER SOVER: 3 


40UP 


( defining words) 


ae i oa ( x addr --- add «x to val at addr) 
TUF >R FR Ft Re FIs 
; F-! ( x addr --- sub x from val at addr) 


DUP =R F@ FSWAF F- Re FI 3 
FVAR ¢ define floating variable) 2VARIABLE 3 
FCON ( define floating constant) 2CONSTANT 3 
FOIM ¢ define single dim array) OnIM + 
FCT» J)DIM ( ml m2 --- define mixn2? fee. matrix) 
O¢I,sJDIM 3 


te tt oe tH 


( common constants and verisbles) 


1,EO0 FCON 12.E90 2.E0 FCON 2,.E0 3.E0 FCON 3.E0 
-~1.E0 FCON -1.E0 1,E2 FCON 1,.E2 1,E3 FCON 1.E3 
O.EO FCON O6,.E90 
FYAR SINX FVAR COSX FVAR TANX 
FVAR SSIGN FVAR CSIGN 
3414159264 FCON FI 1.57079633 FCON FI/2 
6.28318531 FCON 2FI 0-69314718 FCON LN(2) 
0,017453293 FCON DTOR 


( comeerison orerations? HEX 
$ FO= Cress of) SWAF DRGF 7F80 AND O= 35 
‘ eR OGS | oC Soe == FS FO= NOT 
$ FOS { x |[--- f3 DUF O: -ROT FO<> ANT 5 
=. "FOX ( x F-- f) DUF O« -ROT FOL> AND 3 
$ FOP= ¢€ we le-- fF) FO. NOT 3 
t FO¢= ( x --- fF) FO NOT 3 
; FS Cie =-— fh) “ROT = -ROT = ANT 7+ 
LFS ( my oomm-— ff) Fe FO? 3 
ala) 4 Chai SS t} F- FOS # 
f Fis ( soe === $9 FC CNOT + 
; Feo ( GS-6 f) “ES INGT ¢ 
: F<> C) xe oH ft): Fe NOT s 
$ /OABORT ."* Divide hy zero attemeted" CR ERL ER? 3; 
DECIMAL ~--*> 
( maxerminysartrete) 
$ i/X ¢€ w --- ¥ »+-inverse) 
FOUP FO<> IF 1.£0 FSWAF F/ ELSE /OABORT THEN 35 
$ SGN ¢( x -P- & absfx]) 
GUE O= IF 1.E0 ELSE -1.E0 THEN FSWAF FABS ; 
+ FMOT ¢€ & y m--- & ¢4-2=x/us Fractional Fart) 
4TUF F/ FIX FLOAT FX F- 3 
$ FMAX (€ & YB --- 2 eee B=ManOusyd]) 
4TUPF Fe IF FSWAP THEN FIROF 3+ 
$ FMIN ¢€ & YY --- Z eee Z=minixry]) 


4TUF Fo IF FSWAF THEN FOIROF 3 

+ 2ROOT ¢( used by FSQRT) FOURFP 16382 AND 128 + 2/ 14384 OR 
1.03 F/ ADUP F/ Ft FOUP 4.E0 F/ 2>R F/ 2Re Ft 5 

: FSQRT ¢€ « --- ¥ «++SQuUare root} FABS FORUP 1.€0 F> IF 
2ROOT ELSE FOIUF O,.EO Fe» IF 21390950407 FK 2ROOT 
1610612736 F/ ELSE FOROF 0.E0 THEN THEN 3 ~~" 

( trig functions -- 1) 

s KSET FODRUR) 54.4 Fx 125 FP FIX ¢ 

$$ FCR»X) FOVER FOUF FX FOVER FLOAT 2.E0 1/X Ft FX .42 FR 3 

7 LATN FSWAF DROF 1 SWAF DO I 2k 1+ IFLOAT F+ FOVER 
I IFLOAT FX FOUF FR FSWAF F/ -1 +LOOF 1.E0 FH F/ 3 

: 2ATN RKSET FCR+X) LATN ¢ 

$ FATAN (¢€ x --- 4 «+,leave aretan£€x] in radians) 
SGN FOUP, 1.E0 F2 IF i/X 2ATN PI/2 FSWAF F- Fx 
ELSE 2ATN FX THEN 3 

3 FATANCX/Y) ( & YY --- Z 44-088 Ke¥ to get aretan corr auadr) 
SGN FSWAP 2:R F/ FATAN @R> FOS IF FNEGATE FI Ft THEN 
FRUF FO< IF 2FI F+t THEN 3 


( tris functions -- 2) 
3 FASIN ¢ «x --- Yu o++eleave aresin€x] in radians) 
FOUF FOUR FR 1.60 FSWAF F- FSQRT F/ FATAN 3 
: FACOS ¢ «x --~- 3 «++lesave arecos€x] in radians) 
FASIN FPI/2 FSWAP F- 3¢ 
t+ REDUCE ¢ reduce angle to between 0 and 2kri) 
CPI 40UF F/ 0.5 Ft FIX FLOAT FX F- $ 
? SIGNS ( set sigms for siner cosine functions) 
1.E0 SSIGN F! 1.£€0 CSIGN F! FOUP FO= IF -1.E0 SSIGN F! THEN 
FABS FRUFP FI/2 Fe IF -1.E0 CSIGN F! FI FSWAP F- THEN ; 
: TANX/2 ( mM --- 4 «e-calculate tan€x/2]) 
FI/2 F/ FRUF FOUF FR FDOUF 3.9839736E-S FX 2.5229476E-3 
F+t FX 1.9634956E-1 Ft FK 2 0 DO 1,60 FOVER FRUF FR F- 
F/ FOUP Ft LOOF ; 


( trig functions -- 3) 
tf 1SIN ( « --- 4 «escale sine from half angdlerreduced) 
i,EO0 FOVER FOUP FR Ft F/ FORUP Ft SSIGN F@ FX 35 
! 1C0S ¢€ « --- ¥ «eecale cos from half ansle,reduced) 
9,E£0 FSWAF 1.60 FSWAF FOURF FX FH F/ 1,.E0 F- CSIGN F@ FX 5 
? iITAN C «ome yo aseCale tan from half ensle,»reduced) 
1.£0 FOVER FOUR Fx F- FOUF FO> IF F/ FOUR Ft ELSE FIROF 
FOROF 1.E8 THEN SSIGN F@ FX CSIGN F@ FR 3 
t FSIN ¢€ « --~- ¥v «+-cale sine of x im radians) 
REDUCE SIGNS TANX/2 iSIN 3; 
2 (PCOS ( w --- v «secale cosine of « in radians) 
REDUCE SIGNS TANX/2 iCOS + 
; FTAN ( wx --- uo eseCale tansent of «x in radians) 
REDUCE SIGNS TANK/2 iTAN + 


tris functions -- 4) 
S3TRIG ( ealculate all 3 tris functions and store) 
REDUCE SIGNS TANX/2? FOUFP iSIN SINX FI FOUP 1COS 
COSX F! A2TAN TANX F! 3 
* TANHX/2 © & --- yo e+ecale nyrerbolic half andle tangent?) 
2,60 F/ FOUR FOUF FX FOUP O.EG 1 5 DO I IFLOAT Ft 
F/ -2!1+LD0P 3; 
; F/MOT C Mou mo- KS M4) 
FOUF FO> IF F/ FOUF FIX FSWAF FOVER FLOAT F- FSWAF ELSE 
+" ardument error" THEN = 
ites bs ol By Aes Ra ( used in lod/exr functions) 
1,EG FOVER F+ FSWAF 1-.E6 FSWAP F- F/ 3 


oe sy 


( exponential functions -- 1) OCTAL 

3 2KKN ( raise 2 to the int. N fower) 
200 * 40177 + °177777 SWAP + 

Xi2Ke-16 FOUF SWAF [DROP 4000 < + 

IECIMAL 

X<S0> SPIRES WEG CRS. os 

2PEXP TANHX/2 1+T/1-T + 

X=1 LN¢2) F/ 1,.E0 F/MOD DROF DUF 127 > IF DROF FOROF 
+" exe out of ransge® ERI ER? ELSE 2**N FSWAF LN(2) FX 
2EXF FR THEN 3 

+ ONEEXF 1-E0O Ft 3 

{ EXP X<2eewk-16 IF ONEEXF ELSE X<1 IF 2@EXF ELSE X?1 
THEN THEN + 


rt +e 


Se oe te 


( exponential functions -- 2) 
$ -EXF FARBS LEXF i/7X 3 
$3 FEXF ( wo --- 4 «e-ecale exe£Exd) 


FOUP FO< IF -EXP ELSE 1EXP THEN 3; 
$ LOKKX ( raise 10 to the fers & FOWEer) 
0.4342945 F/ FEXF 3 


( los functions) 
+ LNIT 1,60 F- FDOUF 2,£0 Ft F/ FOUP FOUP FX FOUR 40UF Fou 
tis Gert OD TF TELBAT 1/X Ft Fx -2 +LOOF 2.£0 Fx ; 
FRACTION 127 ANI 14384 4+ SWAP 45535 AND SWAF } 
CHARAC FOUF SWAP DROF 32640 ANT 128 / 6 128 6 -- 
FLOAT LN(2) Fx FSWAF 3 
3 FLN C x[--- ¥ .eenatural logarithm) 
FOUP FO> IF CHARAC FRACTION ENIT F+ ELSE -Fo=-tF 1,60 
ELSE .4 can’t take lod of neg mum" ERL ERS THEN THEN 3 


> 
+ 
+ 
* 


+ FLOGIO ¢ x --- y ,,,los base 10) 
FOUP FO= IF 1.£0 ELSE FLN 2.30258528 F/ THEN 3 
? FLOG2 (|x --- yu ..,lod base 2) 


FOUP FO= IF 1,£0 ELSE FLN LN(2) F/ THEN 3 
$ XEXY ( power function) FSWAFP FLN FR FEXF 3 


€ floating Point I70 -- i) 
; “.’ 46 HOLD 3 >; ‘E’ 69 HOLD 3 & CONSTANT FFSIS 
+ FP.D =R SWAP OVER DABS <# R> PTOUP IF 0 DO # LOOP 


THEN ’.° #5 SIGN €> 3 
‘FR oR PLD R> OVER - SPACES TYFE ; 


; PF. DUFF bR ?DUP IF o no 1.-E1 FX LOOF THEN FIX R> 3 

+ FR € 8 AL n2 =-- eoePrint in m2 cols with ni digs) 
oR PF. R> FR 3 

ae er ( x -f- .eePrints fop, number with FFSIG disits) 


FOUUP FABS FLOGIO FOUF FO<= IF IFIX ABS FPSIG + DUP 3 4+ ELSE 
IFIX 1+ FPSIG OVER - © MAX SwWaF OVER + 2+ THEN F.R 
SPACE +5 
t+ $teR (C miin2? ---  ,.verint mio rs justified in n2 zfill mols) 
1- >R S-}D SWAF OVER DABS <# R» 0 00 # LOOF ROT 
O= IF 45 ELSE 43 THEN HOLD #> TYPE. 


¢ floating #oint 1/0 <~ 3) 


VARIABLE EXPONENT ( temrorary storage for fers. OxPOnent) 
e-CSEEELTS €# X¥ --—~ vy seeSpPlit fer. into 1-10 + exponent) 


QO EXPONENT ! FOUF FO<> IF SEN BEGIN FDOUF 1,E1 Fr= 
IF 1.€1 F/ EXPONENT 1+! © ELSE FDOUP 1.EO F< IF 1.61 Fx 
EXPONENT 1-! 0 ELSE 1 THEN THEN UNTIL Fx THEN 3 


> E.R ( x ml m2 --- ,..2rint in exe forms m2 colsy nil digs) 
4 - 0 MIN 2>R (SPLIT) 2R> FeR .«" E" EXPONENT @ 3 4+,R 3 
+ Bs ( xX -4- .eePrint in exp forms free field) 


(SPLIT) F. BS ."* E" EXPONENT @ , ; 


Floating Point I/0 -- 3) 

+ FDUMP (¢ addr nvals --- eoedume floating ’F’ format) 
CR O DO I. 2 .R MAXI 10 MIN O DO DUF J 4 #* + I 4 x 4 
F@ 2 -71F eR LOOP CR 26 +L00P UROF 3 

; EDUMF ( addr mnvals --~- ...dume floating ’E’ format) 
CR 0 010 I 3 .R MAXI 5 MIN O NO DUF J 4 * + I 4 x 4+ 
F@ 4 13 E.R LOOP CR S + Loor DROF 3 

#S 


uF 


{ AyvFerbolic functions) ( mot normally loaded) 


+ FASINH C Mw wee gy *++Dyrerbolic aresine) 
FOUP FRUF FX 1.£0 Ft FSQRT F+t FLN 3 
+ FACOSH ( & --- y *+shyrPerobolic arecosine) 


FDUP 1¢E0 F< IF .* range error® ERI ER2 ELSE FOUF FoUP 


FR 1,E0 F- eh Ft FLN THEN 3 
FATANH ( x --- *e+hererbolic arctansent) 


oo 


FOUF FARS 1.£0 F> IF ." range error" ERi ER2 ELSE FOUF 


1.E0 FH FSWAP 1.E0 FSWAP F- F/ FLN 2.60 F/ THEN ¢ 
$ FSINH ( x --- yu .eehurerbolic sine) 
FOUP FEXF FSWAF FNEGATE FEXP -F= 2,0 (F/ > 
FCOSH ( xX --- ¥ .eehyrerbolic cosine) 
FOUF FEXF FSWAF See FEXP Ft 3,.E0 F/ 3 
+ FTANH ( Mo eH +e+hyrerbolic tansent) 


7+ 


FOUP FIUF Fx FDUF O.EO 1 5 00 I IFLOAT Ft F/ ~-2 4+LoOF 3 


#S 

( FF-11 interface) OCTAL 

ASSEMBLER DEFINITIONS 

0 CONSTANT ACO 1 CONSTANT AC1 2 CONSTANT AC? 
3 CONSTANT ACZ 4 CONSTANT AC4 3 CONSTANT ACS 


170600 10F FARS, 179400 1O0F FCLR, 170706 1OF FNEG; 
171000 EIS20F FMUL> 172000 EIS20F FADD, 173060 EIS20F FSuRB, 
1740060 2O0F STF; 175600 2OF STEXF:, 1746000 2OF STCF, 
177000 EIS20F LIC; 170300 10F STST; 170500 10F FTST; 
170100 10F LIFFS, 170200 10F STFFS;, 
NECIMAL -- 

FP-11 Interface -- 2) OCTAL 


CVRT SWAF 4 + SWAF 3 
LOF, CVRT FADD, 3 
FMOTy CYVRT FMUL» 
STC» 4 + STEXFy 
SETF»s 170001 + }; + SETD, 170011 » 3 
SETI» §70002 , 3 + SETLs” 1700124 .¢ 
LFCCy 170000 » ; + LOCFs CURT LOC? 35 


+ FDIVs CVRT SWAF STF, ; 
+ FCMPs CURT FSUB, 3 
+ LOEXP, CVRT SWAP STCF, 


+h Te oe He Oe Oe Oe ON 
“a> ae 


DECIMAL FORTH DEFINITIONS 


*S 


( FIS interface) OCTAL 
ASSEMBLER DEFINITIONS 


075000 10P FADD, 
975010 10F FSUB; 
075020 10F FMUL, 
075030 10P FDIV, 


DECIMAL FORTH DEFINITIONS 
+S 


a 
7 


( forth benchmark tests losdhPock) 
; STIMER is "jSteart " 3 
: ETINER bot LEnde % 3 


€ FORTH benchmark tests..-integer functions) 
( divide time by nmumober of iterations, subtract the time) 
( for Ti or Til from each time,..A. Henden 1982) 
Home fr ( test of basic LOOF) 
30000 0 STIMNER [10 LOOF ETINER + 


. 2 ( test of I and + - functions. use 1 for input} 
30000 O |STIMER [TO I + I - LOOF ETIMER 3; 
:; T2A ( Same, but using I+ and I- code words) 


$00G0 0 STIMER DO I+ I- LOOP ETIWER ; 
a AS ( test of multiely and divide...use 1 for inrut) 
10001 1 STIMER 20 I * I Y LOOF ETIWER 3 
: TSA ( test of unsigned mul and dive.ssrrimitives for x*/) 
( use 30000 800 for inreut) 
10001 1 STIMER [DO 20DUF Ux 400 U/MOD 2OROF LOOF ETIMER 3 


( FORTH benchmark tests,.-..intesger functions round 2) 
O VARIABLE W ( just 3 temrorary storage location) 
; T4 ( test of 16-bit fetch and store) 

30000 0 STIMER DO W@W ! LOOF ETIMER ; 


His ie ( test of S8-bit fetch and store?) 
30000 0 STIMER DO W C@ WC! LOOF ETIMER 3; 
: 4 ( test of double rrecision add» use 3» for input) 


306000 0 STIMER DG 3, D+ LOOF ETIMER 3 

+ VLA ( test of basic loor with drores:, needed for fer.) 
30000 0 STIMER TO 20UF 20RQFP LOOF ETIMER 3; 

+ T18 ¢ test of CMOVE) FREY @ 5000 0 STIMER Ira 
HUF DUF 200 CMOVE LOOF ETIMER DROF 3 

+ TI8A (¢ test of -CMOVE) FREY @ 5000 0 STIMER NO 

DUP DUP 200 -CMOVE LOOF ETIMER DROF 3; 


( FORTH benchmark tests «++floating eoint) 
em Od ( conversion test.e..-use 21135 for inFut) 
10000 0 STIMER [0 FLOAT FIX LOOF ETIMER ; 
: T8 ( test of multiely) 
10000 0 STIMER [10 2.5 2.5 Fx 20ROF LOOF ETIMER 
aes C2 ( test of divide?) 
10000 0 STIMER [10 2.5 1,2 F/ 20ROF LOOF ETIMER } 
? T19 ( test of add) 
10000 0 STIMER DO 2.5 2.5 F+t 20ROF LOOQF ETINER 3 
ee Le ( test of seuare root... 2.113 a@s inrut) 
1000 0 STIMER DO 20UF FSQRT 20ROF LOOF ETINER 3 
brea es ( test of los base 10 ... 2,113 a5 ineut) 
1000 0 STIMER DO 20UF FLOG1IO 20ROF LOOF ETINER 3 


“ep 


( FORTH benchmark tests ...end of floating roint) 
; T14 ( test of @xronentiation «++ inrut 2.113) 
1000 0 STIMER DO 20UF FEXF 20ROF LOOF ETIMER 3 
e ALS ( test of arctansgent ++ inreut 2.113) 
1000 0 STIMER DO 20UF FATAN 20DROF LOOF ETINER 3 
T1é ( test of Sine «++ inreut 2.113 redisans) 
16000 0 STINER DO 20UF FSIN 20ROF LOOF ETINER ; 


+e 


++ 


TZ ( test of disk access..,-100 seauentisl blocks) 
( nmote.+scant use STIHER nere cuz rmmi interruet on disk) 
101 1 00 I BLOCK OROF LOOQF 3; 

9S 


( FORTH benchmark tests...BYTE Erasthostenes seive?) 
8190 CONSTANT SIZE SIZE 2/ ARRAY FLAGS 


$; DO-FRIME ¢ main word..,loor ten times? 
10 0 STHMER DO FLAGS SIZE 1 FELL 0 SIZE 0 
tO FLAGS I+ ce 
IF I DUFF + 3 + DUP I+ 
BEGIN DUF SIZE = 
WHILE 0 QVER FLAGS + C! OVER + REFEAT 
DROP DROP i+ 
THEN 
LOOF 
I? = IF . .* erimes * THEN LOOF ETIWER 3 


( FORTH benchmark tests «+. Interfece Ase) 
( See FORTH Dimensions IIs mo. 49 fase 112) 
} BENCH STIMER DUF 2/7 i+ SWAF ¢ use ’1000 BENCH’) 
1 GO DUF I i ROT 
2 DO DROF DuUF I /MOL 
DUP O= IF [DIROF DROF 1 LEAVE 
ELSE 1 = IF OROF i 
ELSE DUF O: IF DROF 1 
ELSE O= IF 0 LEAVE 
THEN 
THEN 
THEN 
THEN 
LOOP 
IF 4 .R ELSE [DROF THEN LOOF QROF CR ETIMER 3} 


( Integer benchmark execution block) 
CR so? Ti tests." El 
CR a” T2- bests. 8 1° -T2 


CR ." T2A test: " T2A 

CR a" TS test?" 73 

CR ." T3A test? " OROF 30000 800 TSA 
CR ." T4 test? * T4 

CR: a” TS -pesite::* 15 

CR «"® Té test? * 3% 16 

CR" Tit) tests: * TLL DROF 

CK .* T18| test: * T1i8 

CR .* T1I8A test: * Ti8A 


ating Foint benchmark ection block) 


( flo 
| Che" TH testt® 2143, 77 ZOUROF 
| Cie Le £eStes 9 36 

CRs TS testi) 75 

CR «a "TiO gest? = T25 

GR ve TE See 88 Oo ong 2 Ri 

CR) 6 “Ta S teste 71s 

CR 2? -Ti4 fasts” T13 

CR ." TiS testi* 115 

ERia = Fig Bece rs 134 

20ROF 

#S 

7S 

7S 

( Florey Utility -- 1) ( Coryrisght 1983 Unified Software) 


-€ KEK THIS VERSION FOR RT-11> WON’T WORK FOR RSX-11 *xKK ) 


129 ARRAY FLF BUF ( 256 byte sector storage) 
& ARRAY FLFOFEB ( directive rarameter block) 
4 ARRAY DFILE ( dummy file mame descri-etor) 
J1l2 ARRAY FRUFFER ( block puffer) 
128 CONSTANT B/SEC ( oytes rer sector) 
8 CONSTANT SEC/BLK ( sectors rer forth block) 
26 CONSTANT SEC/TRACK ¢ sectors rer track) 


VARIABLE DIRY 
VARIABLE DRIVE { current drive) 


=< 6658 O FLFPRUF O O O FLPOFPR 
<4 -RADSO OY1)/0 0 0 DFILE >: 


( Florey Utility -- 2) 


=~. CONSTANT .REAT ( read sector function? 
~257 CONSTANT .WRITE ( write sector function) 
~1025 CONSTANT «SIZE ( cneck disk density) 


O OFFSET ! 

( Florey Utility -- 3) 

; SEC ¢€ nm a--- adr «eeret sector adr ?) FLFUFB: 2+ $ 

$ TRACK ¢€( How--- «ee ret track adr) FLFIFB 6 + § 

: SINGLE ( set default seccess method to single density) 


9 “ SECG/ELK ! 128: * B/SEG J! + 
t TOUBLE ¢ set default access method to double density) 
4 * SEC/YELK ! 256 ° BYSEC ! 3 
+ OFEN ( open channel 2 for nom-structured access) 
DFILE 2 ~-LOQKUF IF .* Lookur error® QUIT THEN 3 
t CLOSE ¢ close cnanmnmel 2) 
6 2 EMT374 OROF +5 
' DENSITY (¢( --- val ..,read florry density)- 
»>SIZE FLPDOFB 8 + ! 1 TRACK ! FLPOFB EMT3S75 FLFRBUF @ 
O FLEBUF ! ¢ 


Florey Utaglity -- 4) 


i 

$ DERR IF ." Dlisk r/w error" 42 C@ . QUIT THEN = 

; READ-SEC ¢ adr --- «++read sector) 
+READ FLPOFB 8 + ! FLPDFB EMXT375 DERR FLFBUF 2+ SWAF B/SEC 
CMOVE 3 

$ WRITE-SEC ¢ adr --~- «s+write sector) 


»WRITE FLEDFR 8 + ! FLFEBUF 2+ B/SEC CMOVE 
FLFDFB EMT375 [ERR 3 

So TRSEG ( sect --- ..+-set track and sector) 
SEC/TRACK /MOD TRACK ! i+ SEC ! » 

t FR/W (¢€ adr blk f --- ..+-read or write ouffer) 

DIRX ! SEC/BLK * OFFSET @ + DUFF SEC/BLK + SWAF 0 

I TRSEC DUF DIRX @ IF READ-SEC ELSE WRITE-SEC THEN B/SEC 
+ LOOF DROF 3 


( Florey Utility -- 5) 

$ FREAD ¢ blk --- adr .++read plock into FBUFFER) 
FRUFFER SWAF 1 FR/W FBUFFER = 

>; FWRITE ¢( jblk --- 4e-ewrite block to disk) 
FRUFFER SWAF O FR/W 3 

. FLIST ( DIK --- .+.list on terminal) 


TPECIMAL CR ." SCR # * DUF . FREAD DUF 1024 CONTROLS? 
IF UNFRINT 15 0 DO CR LOOP DROP ELSE 16 0 HO CR I 3 .R 
SPACE DUP I 64 ®* + 64 -TRAILING TYFE LOOP THEN CR 3 


ee 


